home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 25
/
Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso
/
Aminet
/
misc
/
kids
/
ColourIt.lha
/
colour_it
/
COLOURIT_1_3
/
COLOURIT_1_3.amosSourceCode
< prev
next >
Wrap
AMOS Source Code
|
1991-05-01
|
4KB
|
136 lines
Screen Open 1,640,256,2,Hires : Curs Off : Cls 0 : Hide
I
Procedure I
Print ""
Under On : Centre "COLOUR_IT 1.3 BY ANDY PAUL"
Under Off
Print "" : Centre "CREATED USING AMOS"
Print "" : Print ""
Print "COLOUR_IT 1.3 is DISKWARE,if you keep this disk intact with source code"
Print "then please send me some disks,there is no set amount,just send what you feel"
Print "it's worth.This program can be freely distributed as long as no profit is"
Print "made to the copier.(No more than �1.50)"
Print ""
Print ""
Print "Colour_it is quite simply a colouring book.It will flood fill any IFF"
Print "picture lowres."
Print ""
Print "When designing your own pictures using (ie DPaint) it is best to draw"
Print "in 32 colours Low-res.The first colour in your pallette must be colour"
Print "0 in other words Black.Make sure no other colour is black,colour_it will"
Print "not fill anything black,because that is the outline colour."
Print ""
Print "When saving your picture save it in the PICTURES directory on this disk"
Print ""
Print ""
Centre "USING COLOUR-IT"
Print ""
Print ""
Print " Press Right mouse button for colour selection"
Print ""
Print " Press left mouse button to paint"
Print ""
Print " Press L for Load picture Press S for Saving picture"
Print " Press Q to Quit"
Print ""
Print " PRESS A KEY........."
Clear Key : Wait Key
Fade 2 : Wait 20
Screen Open 2,320,256,32,Lowres : Curs Off : Flash Off : Hide : Cls 0
Unpack 6 To 2
On Error Proc HELP
A
End Proc
Procedure A
Show
'Unpack 6 To 2
Hide
Limit Mouse 0,0 To 450,274
Clear Key
Wait Key
Rem now move screen 2 out off the way
Channel 1 To Screen Display 2
Amal 1,"M 0,235,50" : Amal On
Sam Play 1,1,8500
Wait 50
Show On
Pen 1 : Paper 24
Screen Close 1
Screen Open 1,320,256,32,Lowres : Curs Off : Cls 0
Rem load an iff picture
L_OADAGAIN:
F$=Fsel$(":pictures/","","Load a picture")
If F$="" Then Goto 10
If Exist(F$) Then Load Iff F$,1
Sam Play 1,1,10000
10
Screen To Front 2
Screen 1
Repeat
If Mouse Key=1 Then CHECK_P
If Mouse Key=2 Then R_G_B
If Key State(40) Then Gosub L_OADAGAIN
If Key State(33) Then C_OLITSAVE
If Key State(16) Then Cls 0 : Screen 2 : Cls 0 : Screen 1 : Locate ,15 : Pen 1 : Paper 0 : Centre "THANK YOU,THAT WAS FUN" : Wait 150 : End
Until FIN=True
End Proc
Procedure CHECK_P
Rem check to see if point x mouse,y mouse is colour 0 or black
A=X Mouse-128 : B=Y Mouse-42
If Point(A,B)=0 : Sam Play 2,2,8000
Else
Screen 1 : Paint A,B,0 : Wait 10
End If
End Proc
Procedure R_G_B
Rem lets get the colour you want and also put it on screen 2
RGBWINDOW[120,20,12]
_COL=Param
Rem cant have them choosing black can we ?
If _COL=0 Then _COL=1
Ink _COL
End Proc
Procedure RGBWINDOW[X,Y,SIZE]
Rem a nice little proc by Gary Fearn (what a nice man)
NCOLS=Screen Colour
Get Cblock 1,X-10,Y-10,X+(SIZE*2)+10,Y+(SIZE*NCOLS/2)+10
Bar X-8,Y-8 To X+(SIZE*2)+8,Y+(SIZE*NCOLS/2)+8
Reserve Zone NCOLS+1
For B=0 To NCOLS/2 Step NCOLS/2
For A=0 To(NCOLS/2)-1
Ink A+B : Bar X,Y To X+SIZE,Y+SIZE
Set Zone A+B+1,X,Y To X+SIZE,Y+SIZE
Add Y,SIZE
Next A
Add X,SIZE
Add Y,-(SIZE*(NCOLS/2))
Next B
AGAIN:
While M=0
X=Mouse Zone
M=Mouse Key
Wend
If X=0 Then M=0 : Goto AGAIN
Put Cblock 1
Reset Zone
RGB=X-1 : Rem RGB = selected colour
Wait 10
End Proc[RGB]
Procedure C_OLITSAVE
Rem save an iff picture
Clear Key
F$=Fsel$(":ALBUM/","","Save Pic as......")
If F$="" Then Pop Proc
Save Iff F$,1
End Proc
Procedure HELP
Screen Open 3,320,40,4,Lowres : Cls 0 : Paper 0 : Pen 3
Bell
Print ""
Centre "AN ERROR HAS BEEN DETECTED"
Print ""
Centre "PLEASE TRY AGAIN....WAIT"
Wait 150
Screen Close 3
Resume Next
End Proc